home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / lstusr14.zip / LISTUSER.BAS next >
BASIC Source File  |  1990-04-18  |  7KB  |  249 lines
  1. ' List the RBBS User file several ways
  2. '  Copyright 1990 - Allen P. Dew
  3. '
  4. 1000 KEY OFF: CLS
  5.      ON ERROR GOTO 9900
  6.      Way$ = ""
  7.      Num& = 0
  8.      DRV$ = "D:"
  9.      CNAM$ = "MAINU.DEF"
  10.      INPUT "USERS file is on drive:path [D:]"; XDRV$
  11.      INPUT "Name of USERS file: [Mainu.def] "; XCNAM$
  12.      IF XDRV$ <> "" THEN DRV$ = XDRV$
  13.      IF XCNAM$ <> "" THEN CNAM$ = XCNAM$
  14.      FINAM$ = DRV$ + CNAM$
  15.      OPEN FINAM$ FOR INPUT AS #1
  16.      CLOSE #1
  17.      GOSUB 9400
  18.      PRINT "Please wait while work file is built"
  19. 1050 OPEN "USERWKX" FOR OUTPUT AS #2
  20.      CLOSE #2
  21.      KILL "USERWKX"
  22.      OPEN "USERWKX" FOR RANDOM AS #2 LEN=128
  23.      FIELD #2, 128 AS NN$
  24.      Num& = 0
  25.      FOR I& = 1 TO LAST&
  26.             GOSUB 8300
  27.          IF ASC(ZUserName$) > 32 AND LEFT$(ZUserName$,7) <> "NEWUSER" THEN
  28.              W% = INSTR(ZUserName$," ")
  29.              ZFirst$ = LEFT$(ZUserName$,W%-1)
  30.              ZLast$ = MID$(ZUserName$,W%+1,31-W%)
  31.              ZLast$ = RTRIM$(ZLast$) + ", "
  32.              W% = LEN(ZLast$)
  33.              LSET ZUserName$ = ZLast$
  34.              MID$(ZUserName$,W%+1,31-W%) = ZFirst$
  35.                 LSET NN$ = N$
  36.              Num& = Num& + 1
  37.                 PUT #2,Num&
  38.          END IF
  39.      NEXT I&
  40.      CLOSE
  41.  
  42. 1100 CLS
  43.      CNT = 0
  44.      LOCATE 2, 18
  45.      PRINT "==  List the RBBS Users File  ==               V1.4"
  46.      PRINT TAB(20); Num&; " users found in "; CNAM$
  47.      PRINT
  48.      PRINT TAB(20); "A - List by name"
  49.      PRINT TAB(20); "B - List by city-state"
  50.      PRINT TAB(20); "C - List by last time on"
  51.      PRINT
  52.      PRINT TAB(20); "W - Open a different User file"
  53.      PRINT TAB(20); "X - Exit this program"
  54.      LOCATE 24, 8
  55.      PRINT "Copyright 1990 Allen Dew       Geneal Board         919-471-6026";
  56. 1200 LOCATE 16, 1
  57.      PRINT TAB(20); "Enter letter to do ==>          "
  58.      LOCATE 16, 43
  59.      INPUT "", ACT$
  60.      ACT$ = UCASE$(LEFT$(ACT$, 1))
  61.      IF ACT$ = "X" THEN GOTO 9000
  62.      IF ACT$ = "W" THEN
  63.          CLOSE
  64.          GOTO 1000
  65.      END IF
  66.      IF ACT$ < "A" OR ACT$ > "C" THEN
  67.             BEEP
  68.             GOTO 1200
  69.      END IF
  70.      IF ACT$ = "A" THEN GOSUB 3000
  71.      IF ACT$ = "B" THEN GOSUB 3100
  72.      IF ACT$ = "C" THEN GOSUB 3200
  73.      GOTO 1100
  74.  
  75. 3000 '        LIST BY NAME
  76.      CLOSE
  77.      IF Way$ = "N" THEN GOTO 3020
  78.      PRINT "Sorting by name....."
  79.      SHELL "SORTF USERWKX USERWKY /L128 /+1,31 /C /Q"
  80. 3020 '
  81.      FINAM$ = "USERWKY"
  82.      Way$ = "N"
  83.      GOSUB 9400
  84.      GOSUB 7000
  85.      RETURN
  86.  
  87. 3100 '        LIST BY CITY
  88.      CLOSE
  89.      IF Way$ = "C" THEN GOTO 3120
  90.      PRINT "Sorting by city....."
  91.      SHELL "SORTF USERWKX USERWKY /L128 /+63,24 /+1,31 /C /Q"
  92. 3120 '
  93.      FINAM$ = "USERWKY"
  94.      Way$ = "C"
  95.      GOSUB 9400
  96.      GOSUB 7000
  97.      RETURN
  98.  
  99. 3200 '        LIST BY LAST TIME ON
  100.      CLOSE
  101.      IF Way$ = "D" THEN GOTO 3220
  102.      PRINT "Sorting by last time on....."
  103.      SHELL "SORTF USERWKX USERWKY /L128 /-112,2 /-106,14 /+1,31 /C /Q"
  104. 3220 '
  105.      FINAM$ = "USERWKY"
  106.      Way$ = "D"
  107.      GOSUB 9400
  108.      GOSUB 7000
  109.      RETURN
  110.  
  111. 7000 '        SHOW LINES ON DISPLAY
  112.      FOR I& = 1 TO LAST&
  113.             GOSUB 8300
  114.             L$ = ZUserName$ + "  " + ZCityState$ + " " + ZLastDateTimeOn$
  115.          GOSUB 8000
  116.      NEXT I&
  117.      GOSUB 8200
  118.      RETURN
  119.  
  120. 7500 '        LIST VARIABLE SEARCH DATA
  121.      FOR I& = LAST& TO 1 STEP -1
  122.             GOSUB 8300
  123.             W% = INSTR(N$, ONAT$)
  124.             X% = INSTR(N$, LNT$)
  125.             IF W% <> 0 THEN W$ = N$: M% = 1
  126.             IF X% <> 0 THEN X$ = N$
  127.             K% = INSTR(N$, VARB$)
  128.             IF K% <> 0 AND M% <> 0 THEN
  129.                    L$ = W$
  130.                    GOSUB 8000
  131.                    L$ = X$
  132.                    GOSUB 8000
  133.                    M% = 0
  134.             END IF
  135.             IF K% <> 0 THEN
  136.                    L$ = N$
  137.                    GOSUB 8000
  138.             END IF
  139.      NEXT I&
  140.      GOSUB 8200
  141.      RETURN
  142. 8000 '
  143.      PRINT L$
  144.      CNT = CNT + 1
  145.      IF CNT < 23 THEN RETURN
  146.      CNT = 0
  147.      INPUT "--more--[y]/n"; CNT$
  148.      CNT$ = UCASE$(LEFT$(CNT$, 1))
  149.      IF CNT$ = "N" THEN I& = LAST& +1
  150.      RETURN
  151. 8200 '
  152.      PRINT ""
  153.      INPUT "That's all. Enter to continue.", CNT$
  154.      RETURN
  155. 8300 '
  156.      GET #1, I&
  157.      TEST$ = INKEY$
  158.      IF LEN(TEST$) = 0 THEN RETURN
  159.      IF ASC(TEST$) = 27 THEN I& = 1
  160.      GOSUB 9500
  161.      RETURN
  162. 8400 '
  163.      LOCATE 17, 10
  164.      PRINT "Use the ESC key to halt search."
  165.      LOCATE 18, 10
  166.      PRINT LYN$;
  167.      INPUT CALR$
  168.      PRINT
  169.      RETURN
  170. 9000 '
  171.      CLOSE
  172.      CLS
  173.      SYSTEM
  174.  
  175. 9400 '
  176.      OPEN "R", #1, FINAM$, 128
  177.      LAST& = LOF(1) / 128
  178.  
  179.      FIELD #1, 128 AS N$
  180.      FIELD #1, 31 AS ZUserName$, _
  181.                15 AS ZPswd$, _
  182.                 2 AS ZSecLevel$, _
  183.                14 AS ZUserOption$,  _
  184.                24 AS ZCityState$, _
  185.                 3 AS ZMachineType$, _
  186.                 4 AS ZTodayDl$, _
  187.                 4 AS ZTodayBytes$, _
  188.                 4 AS ZDlBytes$, _
  189.                 4 AS ZULBytes$, _
  190.                14 AS ZLastDateTimeOn$, _
  191.                 3 AS ZListNewDate$, _
  192.                 2 AS ZUserDnlds$, _
  193.                 2 AS ZUserUplds$, _
  194.                 2 AS ZElapsedTime$
  195.      RETURN
  196.  
  197. 9500 '        EXPLODE THE USER DATA
  198.      ZUserSecLevel = CVI(ZSecLevel$)
  199.      ZLastMsgRead = CVI(MID$(ZUserOption$,3,2))
  200.      ZUserXferDefault$ = MID$(ZUserOption$,5,1)
  201.      IF ZUserXferDefault$ = " " THEN
  202.         ZUserXferDefault$ = "N"
  203.      END IF
  204.      WasX = ASC(MID$(ZUserOption$,6,1))
  205.      ZWasGR = (WasX MOD 3)
  206.      ZBoldText$ = CHR$(48 - (WasX > 50))
  207.      ZUserTextColor = (WasX - ZWasGR)/3 + 21
  208.      IF ZUserTextColor > 37 THEN
  209.         ZUserTextColor = ZUserTextColor - 7
  210.      END IF
  211.      ZRightMargin = CVI(MID$(ZUserOption$,7,2))
  212.      IF ZRightMargin > 72 THEN
  213.         ZRightMargin = 72
  214.      END IF
  215.      XCityState$ = LTRIM$(RTRIM$(ZCityState$))
  216.      UserOptions = CVI(MID$(ZUserOption$,9,2))
  217.      ZPromptBell = (UserOptions AND 1) > 0
  218.      ZExpertUser = (UserOptions AND 2) > 0
  219.      ZNulls = (UserOptions AND 4) > 0
  220.      ZUpperCase = (UserOptions AND 8) > 0
  221.      ZLineFeeds = (UserOptions AND 16) > 0
  222.      ZCheckBulletLogon = (UserOptions AND 32) > 0
  223.      ZSkipFilesLogon = (UserOptions AND 64) > 0
  224.      ZAutoDownDesired = (UserOptions AND 128) > 0
  225.      ZReqQuesAnswered = (UserOptions AND 256) > 0
  226.      ZMailWaiting = (UserOptions AND 512) > 0
  227.      ZHilite = (UserOptions AND 1024 ) > 0
  228.      ZTurboKeyUser = (UserOptions AND 2048) > 0
  229.      ZPageLength = ASC(MID$(ZUserOption$,13,1))
  230.      ZEchoer$ = MID$(ZUserOption$,14,1)
  231.      IF INSTR("ICR",ZEchoer$) = 0 THEN
  232.         ZEchoer$ = "R"
  233.      END IF
  234.      RETURN
  235.  
  236. 9900 '
  237.      IF ERR <> 53 THEN               ' FILE NOT FOUND
  238.          PRINT "Error  "; ERR; "   at line  "; ERL
  239.          END
  240.      END IF
  241.      IF ERL = 1050 THEN RESUME NEXT
  242.      PRINT ""
  243.      INPUT "Callers file not found. Retry ? Y/N ", CNT$
  244.      CNT$ = UCASE$(LEFT$(CNT$, 1))
  245.      IF CNT$ = "Y" AND LEFT$(FINAM$,6) <> "USERWK" THEN RESUME 1000
  246.      IF CNT$ = "N" THEN RESUME 9000
  247.      GOTO 9900
  248.  
  249.